home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
bbs
/
mxu_v152.zip
/
WFC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-06-01
|
13KB
|
406 lines
{
───────────────────────────────────────────────────────────────────────────────
▀▀▀ ▀▀▀ ▀▀▀▀▀ ▀▀ ▀▀
▀▀▀▀ ▀▀▀▀ ▀▀ ▀▀ ▀▀ ▀▀
▀▀ ▀▀▀ ▀▀ ▀▀▀▀▀▀▀ ▀▀▀ ╔══ ╦═╗ ╔═╗ ╦═╗ ╦ ╦ ╦ ╔═╗ ╔═╗
▀▀ ▀ ▀▀ ▀▀ ▀▀ ▀▀ ▀▀ ║ ╦ ╠╦╝ ╠═╣ ╠═╝ ╠═╣ ║ ║ ╚═╗
▀▀ ▀▀ ▀▀ ▀▀ ▀▀ ▀▀ ╚═╝ ╩╚═ ╩ ╩ ╩ ╩ ╩ ╩ ╚═╝ ╚═╝
───────────────────────────────────────────────────────────────────────────────
The Universal Multimedia Interface For BBS Software
Copyright 1995-Current * Larry L. Athey * BBS Utiliteez Software
───────────────────────────────────────────────────────────────────────────────
Information Regarding MAX Graphics:
───────────────────────────────────
Notice is hereby given that the MAXscript/MAXcontrol/MAXcolor language,
and MAXterm are products of BBS Utiliteez Software and are protected by
US copyrights listed with the US Library Of Congress (1996)....
No changes, additions, subtractions, or other modifications shall be made
to MAXscript/MAXcontrol/MAXcolor language or the MAX Graphics development
kit without express written permission from Larry L. Athey, BBS Utiliteez
Software, Alliance, Nebraska, USA....
The MAXscript/MAXcontrol/MAXcolor language may be used in any BBS or Door
software 100% royalty free. You are also allowed to implement full local
graphics viewing in any BBS or Door software 100% royalty free. However,
any program that uses the MAXscript/MAXcontrol/MAXcolor language *MUST*
bear the MAX Graphics/BBS Utiliteez Software copyright notice....
Example: MAX Graphics and the MAXscript/MAXcontrol/MAXcolor language is
(C) 1995-Current * Larry L. Athey * BBS Utiliteez Software
───────────────────────────────────────────────────────────────────────────────
NOTE: This door requires Async Professional for DOS before you can
compile it.}
{$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}
PROGRAM WFC;
USES CRT, DOS, __TEXT, TDK_VARS, DOORKIT1,
DOORKIT2, DOORKIT3, APVARS, PORTUNIT;
VAR
MinBaud : STRING[6];
UserTime : STRING[4];
NodeStr : STRING[3];
BaudStr : STRING;
WorkPath : STRING;
HomeDir : STRING;
Scrn : ARRAY[1..11] OF STRING[33];
PROCEDURE UpdateArray(St : STRING);
VAR
X : BYTE;
S : STRING;
BEGIN
S := '';
IF (St = #13) OR (St = #10) THEN EXIT;
FOR X := 1 TO LENGTH(St) DO IF St[X] > #31 THEN S := S + St[X];
FOR X := 1 TO 10 DO Scrn[X] := Scrn[X + 1];
Scrn[11] := PadRight(S,' ',33);
FOR X := 1 TO 11 DO OutTextXY(44,4 + X,7,0,Scrn[X]);
END;
PROCEDURE NewDefaults;
BEGIN
CS.CPBfg := 3;
CS.CPBbg := 1;
CS.CPKfg := 14;
CS.CPKbg := 1;
CS.CPTfg := 11;
CS.CPTbg := 1;
END;
PROCEDURE SetUpScreen;
BEGIN
FILLCHAR(Scrn,SIZEOF(Scrn),0);
MemW[$0000 : $041C] := MemW[$0000 : $041A];
DrawWindow(1,1,80,25,'WFC.EXE - Waiting For Caller Unit');
InvertedBox(43,4,77,16);
OutTextXY(44,4,15,9,' Modem Results ');
WINDOW(44,5,76,15);
TEXTCOLOR(3); TEXTBACKGROUND(0); CLRSCR;
WINDOW(1,1,80,25);
InvertedBox(4,4,40,16);
OutTextXY(5,4,15,9, ' SysOp Function Keys ');
InvertedBox(4,18,77,23);
MenuKey(7,6,'A',' Manual Answer');
MenuKey(7,7,'I',' Initialize Modem');
MenuKey(7,8,'M',' MAXupdate CTL Editor');
MenuKey(7,9,'L',' Local Logon');
MenuKey(7,10,'V',' View Activity Log');
MenuKey(7,11,'D',' Shell To DOS');
MenuKey(7,12,'X',' Exit With Modem Busy');
MenuKey(7,13,'Q',' Quit With Modem Ready');
HideCursor;
OutTextXY(5,18,15,9,' Miscellaneous Information ');
OutTextXY(7,19,11,1,ProgramName);
OutTextXY(7,20,11,1,ProgramDesc);
OutTextXY(7,21,11,1,'Running Under ' + OsStr);
OutTextXY(53,19,14,1,'Free Memory:');
OutTextXY(66,19,15,1,IntToStr(MEMAVAIL));
OutTextXY(60,20,14,1,'Node:');
OutTextXY(66,20,15,1,IntToStr(DoorSys.Node));
OutTextXY(60,21,14,1,'Date:');
OutTextXY(66,21,15,1,DateVariable);
OutTextXY(60,22,14,1,'Time:');
IF Ctl.UseFossil THEN CommDef.Device := 2 ELSE CommDef.Device := 1;
IF Ctl.UseDigi THEN CommDef.Device := 3;
IF Ctl.NSP THEN CommDef.PortAddr := Ctl.HexAddr ELSE CommDef.PortAddr := '0';
IF Ctl.NSP THEN CommDef.IRQ := Ctl.IRQ ELSE CommDef.IRQ := 0;
IF Ctl.PortSpeed < 9600 THEN CommDef.HwFlow := FALSE ELSE CommDef.HwFlow := TRUE;
CommDef.Baud := Ctl.PortSpeed;
CommDef.Port := Ctl.Port;
CommDef.In_Buffer := Ctl.InBuffer;
CommDef.Out_Buffer := Ctl.OutBuffer;
IF PortUnit.InitComport THEN UpdateArray('Comport Successfully Opened') ELSE BEGIN
UpdateArray('Cannot Open Comport!!');
AlertTones;
ShutDownText;
ErrorLog('Cannot Open Comport!!',1,TRUE);
END;
END;
PROCEDURE InitTheModem;
BEGIN
IF Modem.Init1 <> '' THEN BEGIN
ModemCommand(Modem.Init1);
UpdateArray(ModemResult);
END;
IF Modem.Init2 <> '' THEN BEGIN
ModemCommand(Modem.Init2);
UpdateArray(ModemResult);
END;
END;
PROCEDURE AnswerCall;
VAR
RC : STRING[80];
Ch : CHAR;
C : CHAR;
Cnt : BYTE;
S100 : WORD;
Sec : WORD;
BEGIN
Sec := 0;
Cnt := 0;
RC := '';
BaudStr := '';
UpdateArray(Modem.Answer);
UpdateArray('Press Any Key To Hang Up');
ModemCommand(Modem.Answer);
REPEAT
WITH CurTime DO GETTIME(Hour,Min,Sec,S100);
IF Sec <> CurTime.Sec THEN BEGIN
Sec := CurTime.Sec;
INC(Cnt);
END;
IF KEYPRESSED THEN Cnt := 30;
IF DataAvailable THEN BEGIN
WHILE DataAvailable DO BEGIN
Ch := ReadChar;
IF Ch > #31 THEN RC := RC + Ch;
END;
END;
IF RC = 'CONNECT' THEN BaudStr := '300';
IF POS('CONNECT 1200',RC) > 0 THEN BaudStr := '1200';
IF POS('CONNECT 1275',RC) > 0 THEN BaudStr := '1275';
IF POS('CONNECT 2400',RC) > 0 THEN BaudStr := '2400';
IF POS('CONNECT 4800',RC) > 0 THEN BaudStr := '4800';
IF POS('CONNECT 7200',RC) > 0 THEN BaudStr := '7200';
IF POS('CONNECT 9600',RC) > 0 THEN BaudStr := '9600';
IF POS('CONNECT 12000',RC) > 0 THEN BaudStr := '12000';
IF POS('CONNECT 14400',RC) > 0 THEN BaudStr := '14400';
IF POS('CONNECT 16800',RC) > 0 THEN BaudStr := '16800';
IF POS('CONNECT 19200',RC) > 0 THEN BaudStr := '19200';
IF POS('CONNECT 21600',RC) > 0 THEN BaudStr := '21600';
IF POS('CONNECT 24000',RC) > 0 THEN BaudStr := '24000';
IF POS('CONNECT 26400',RC) > 0 THEN BaudStr := '26400';
IF POS('CONNECT 28800',RC) > 0 THEN BaudStr := '28800';
IF POS('CONNECT 31200',RC) > 0 THEN BaudStr := '31200';
IF POS('CONNECT 33600',RC) > 0 THEN BaudStr := '33600';
UNTIL (Cnt = 30) OR (Ch = #13) OR (Ch = #10);
IF (Cnt = 30) AND (POS('CONNECT',RC) = 0) THEN RC := 'NO CARRIER';
UpdateArray(RC);
SOUND(220);
DELAY(150);
NOSOUND;
Wait(2);
KillWindow;
ShutDownText;
DeInitComport;
IF StrToInt(BaudStr) >= StrToInT(MinBaud) THEN BEGIN
_Execute('MAKEDROP.EXE',' /N' + NodeStr + ' /S' + BaudStr + ' /M' + UserTime + ' /D=' + WorkPath);
_Execute('UP_DOOR.EXE',' /N' + NodeStr + ' /S' + BaudStr + ' /R=' + WorkPath + 'DORINFO1.DEF');
_RunBatFile('BBS.BAT ' + NodeStr + ' ' + BaudStr);
END;
FireUpText; HideMouse; HideCursor;
SetUpScreen;
Cnt := 0;
IF Carrier THEN REPEAT
INC(Cnt);
HangUp;
Wait(1);
UNTIL (NOT Carrier) OR (Cnt = 5);
InitTheModem;
END;
PROCEDURE ShutDownWFC;
BEGIN
DeInitComport;
KillWindow;
ShutDownText;
END;
PROCEDURE ShowTime;
VAR
Pm : STRING[2];
MHour : BYTE;
BEGIN
TimeSlice;
WITH CurTime DO BEGIN
IF (Hour IN [0..11]) THEN Pm := 'am' ELSE Pm := 'pm';
MHour := Hour;
IF MHour = 0 THEN MHour := 12;
IF MHour > 12 THEN DEC(MHour,12);
OutTextXY(66,22,15,1,PadLeft(IntToStr(MHour),'0',2) + ':' +
PadLeft(IntToStr(Min),'0',2) + ':' +
PadLeft(IntToStr(Sec),'0',2) + Pm);
END;
END;
PROCEDURE WaitForCall;
VAR
QuitProg : BOOLEAN;
Ch,X : CHAR;
St : STRING;
S100,Sec : WORD;
BEGIN
QuitProg := FALSE;
REPEAT
St := '';
WITH CurTime DO GETTIME(Hour,Min,Sec,S100);
IF Sec <> CurTime.Sec THEN BEGIN
Sec := CurTime.Sec;
ShowTime;
END;
IF DataAvailable THEN BEGIN
St := '';
REPEAT
X := ReadChar;
IF X > #31 THEN St := St + X;
UNTIL NOT DataAvailable;
UpdateArray(St);
IF POS('RING',AllCaps(St)) > 0 THEN AnswerCall;
END;
Ch := #0;
IF KEYPRESSED THEN Ch := UPCASE(READKEY);
IF Ch <> #0 THEN CASE Ch OF
'A' : AnswerCall;
'I' : InitTheModem;
'M' : BEGIN
ModemCommand(Modem.OffHook);
ShutDownWFC;
_Execute('MAKECTL.EXE',' '+NodeStr);
FireUpText; HideMouse; HideCursor;
NewDefaults;
SetUpScreen;
ModemCommand(Modem.OnHook);
InitTheModem;
END;
'L' : BEGIN
ModemCommand(Modem.OffHook);
ShutDownWFC;
_Execute('UP_DOOR.EXE',' /L /N' + NodeStr);
FireUpText; HideMouse; HideCursor;
NewDefaults;
SetUpScreen;
ModemCommand(Modem.OnHook);
InitTheModem;
END;
'V' : BEGIN
ModemCommand(Modem.OffHook);
ShutDownWFC;
CS.CPBfg := 9;
CS.CPBbg := 0;
CS.CPKfg := 14;
CS.CPKbg := 0;
CS.CPTfg := 13;
CS.CPTbg := 0;
IF FExist(LogPath + LogFile) THEN ShowTextFile(LogPath + LogFile)
ELSE OutTxtXY(1,7,12,0,LogPath + LogFile + ' Not Found!');
FireUpText; HideMouse; HideCursor;
NewDefaults;
SetUpScreen;
ModemCommand(Modem.OnHook);
InitTheModem;
END;
'D' : BEGIN
ModemCommand(Modem.OffHook);
ShutDownWFC;
DosShell;
FireUpText; HideMouse; HideCursor;
NewDefaults;
SetUpScreen;
ModemCommand(Modem.OnHook);
InitTheModem;
END;
'X' : BEGIN
ModemCommand(Modem.OffHook);
ShutDownWFC;
QuitProg := TRUE;
END;
'Q' : BEGIN
ModemCommand(Modem.OnHook);
ShutDownWFC;
QuitProg := TRUE;
END;
END;
UNTIL QuitProg;
END;
PROCEDURE StartUp;
VAR
Cfg : TEXT;
KeyFile : TEXT;
St : STRING[4];
SName : STRING[30];
KeyLine : STRING;
GoodKey : BOOLEAN;
BEGIN
ShowProgramAd;
WRITELN;
DoorSys.Node := StrToInt(PARAMSTR(1));
NodeStr := PARAMSTR(1);
ReadCTL;
GETDIR(0,HomeDir);
WorkPath := HomeDir + '\WORK' + NodeStr + '\';
MakeDir(WorkPath);
ASSIGN(Cfg,'WFC' + NodeStr + '.CFG');
IF NOT FExist('WFC' + NodeStr + '.CFG') THEN BEGIN
ShutDownText;
ShowProgramAd;
OutTxtXY(1,7,12,0,'CRITICAL ERROR - WFC' + NodeStr + '.CFG NOT FOUND!');
AlertTones;
DELAY(5000);
ErrorLog('CRITICAL ERROR - WFC' + NodeStr + '.CFG NOT FOUND!',6,TRUE);
END;
RESET(Cfg);
READLN(Cfg,Modem.Init1);
READLN(Cfg,Modem.Init2);
READLN(Cfg,Modem.Answer);
READLN(Cfg,St); CommDef.Command_Delay := StrToInt(St);
READLN(Cfg,MinBaud);
READLN(Cfg,UserTime);
CLOSE(Cfg);
Modem.OffHook := 'ATM0H1';
Modem.OnHook := 'ATM1H0';
IF NOT FExist('UP_DOOR.CFG') THEN ErrorLog('CRITICAL ERROR: UP_DOOR.CFG IS MISSING!',6,TRUE);
ASSIGN(Cfg,'UP_DOOR.CFG');
RESET(Cfg);
READLN(Cfg);
READLN(Cfg);
READLN(Cfg);
READLN(Cfg);
READLN(Cfg);
READLN(Cfg,LogPath);
READLN(Cfg,LogFile);
CLOSE(Cfg);
LogPath := CvtVars(LogPath);
LogFile := CvtVars(LogFile);
CHDIR(HomeDir);
OutTxtL(11,0,'■ Running Under ' + OsStr);
IF Ctl.UseDigi THEN OutTxt(3,0,'■ Using DigiBoard Comm Routines.') ELSE BEGIN
IF Ctl.UseFossil THEN OutTxt(3,0,'■ Using Fossil Comm Routines.')
ELSE OutTxt(3,0,'■ Using UART Comm Routines.');
END;
HideCursor;
Wait(2);
END;
{============================================================================}
BEGIN
ProgramName := 'MAXupdate WFC Unit';
ProgramDesc := 'MAX Graphics Front End System';
FireUpText; HideMouse; HideCursor;
NewDefaults;
IF PARAMCOUNT < 1 THEN BEGIN
ShutDownText;
ShowProgramAd;
IceText('Syntax:',TRUE);
LineBar(1,0,7);
IceText('WFC.EXE [Node Number]',TRUE);
sGotoXY(1,24);
AnyKey;
ErrLevel := 1;
HALT(ErrLevel);
END;
StartUp;
SetUpScreen;
InitTheModem;
WaitForCall;
END.